home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 5
/
Aminet 5 - March 1995.iso
/
Aminet
/
util
/
rexx
/
smacros.lha
/
FWMacros
/
Create_BarGraph.arexx
< prev
next >
Wrap
Text File
|
1994-12-17
|
8KB
|
312 lines
/* Create_BarGraph
A Macro by Steven. R. Giovenella, 5823 Dutchess Dr., Colorado Springs, CO 80918.
© Copyright 1994 Steven. R. Giovenella, All rights reserved.
This macro is my gift to the Amiga community. It may be given away free to
anyone, but it may NOT be sold in any way, shape, or form, not even for the cost of
reproduction, downloading, shipping, or handling, without express written
permission from the author listed above. Any person or company who violates the
content of the previous sentence, agrees to pay Steven R. Giovenella $1,000 (US) for
each copy of this macro sold. This macro may NOT be added to any disk which is to
be sold for any price or fee, to include shipping and handling. The ONLY way this
macro may be distributed is on a disk which is given away 100% free of all charges,
or on via telecommunications networks which do not charge any additional fee as a
result of a user downloading this particular macro. This macro may only be
reproduced in its entirety, including all comment lines and code. The individual
user may alter this macro for personal use, but may not then distribute the macro
in any modified form. If you wish, feel free to send me some cash, a Christmas card,
some other piece of software, or absolutely nothing as a gift for creating this macro.
The author of this software is not responsible for any data loss or damage to
computer equipment as a result, direct or indirect, of the use of this macro. */
Options Results
/****************************/
/* Ask questions */
/* Warning */
Showmessage 2 0 '" ** WARNING **" " This Macro
will alter the current document." "Unless the document is empty, save before
proceeding." " Proceed " " Save now " " Quit "'
IF Result = 2 THEN SaveAs
IF Result = 3 THEN Exit
ShowMessage 1 0 '"Select border option..." "" "" " 2 pts " " 1 pt " "
None "'
IF Result = 1 THEN border = 2
IF Result = 2 THEN border = 1
IF Result = 3 THEN border = None
ShowMessage 1 0 '"Select text flow..." "" "" " Left " " Right " " None
"'
IF Result = 1 THEN tflow = LeftVert
IF Result = 2 THEN tflow = RightVert
IF Result = 3 THEN tflow = None
RequestText '"Create Bar Graph" "Enter maximum value for vertical axis" ""'
maxY = Result
RequestText '"Create Bar Graph" "Enter vertical axis increments" ""'
increment = Result
/***********************************************/
/* Data Interpreter */
/* Store current begline and endline */
Status LinePos
Coords = Result
PARSE VAR Coords BegLine BegPos EndLine EndPos
IF ( EndLine = "" ) THEN DO
ShowMessage 1 0 '"No Range Selected" "" "" " OK " "" ""'
Exit
END
IF EndPos=0 THEN EndLine=EndLine-1
/* Count bars */
bars = EndLine - BegLine - 2
/* Get Title */
MoveToLine BegLine 0
ShiftDown
CtrlDown
AltDown
Cursor right
Extract
title.1 = Result
ShiftUp
CtrlUp
AltUp
/* Get Subtitle */
MoveToLine BegLine+1 0
ShiftDown
CtrlDown
AltDown
Cursor right
Extract
title.2 = Result
ShiftUp
CtrlUp
AltUp
/* Get rest of data */
/* Add Trailing Spaces */
DO line = (BegLine+3) to EndLine
MoveToLine line 0
CtrlDown
AltDown
Cursor right
type " "
END
/* Extract Data x.0 and y.0 through x.count and y.count */
count = 0
DO line = (BegLine+2) to EndLine
MoveToLine line 0
Status ParaChars
pchars = Result
DO i=0 to pchars
MoveToLine line i
Extract
char = Result
IF char = " " THEN LEAVE
END
MoveToLine line i
ShiftDown
CtrlDown
AltDown
Cursor left
Extract
x.count = Result
ShiftUp
MoveToLine line (i+1)
ShiftDown
Cursor right
AltUp
CtrlUp
IF line ~= (Begline+2) THEN Cursor left
Extract
r = Result
IF count = 0 THEN y.count = r
ELSE DO
PARSE VAR r r1
y.count = Value('r1')
END
ShiftUP
CtrlUp
AltUP
count = count +1
END
/***********************************************/
/* Draw graph */
/* Get precise coordinates for placing graph */
/* In order to get scroll position */
/* Move to end of document */
CtrlDown
AltDown
Cursor Down
CtrlUP
AltUp
/* Insert a page break */
InsertPageBreak
/* Movetoline begline */
MoveToLine BegLine 0
/* Get scroll position */
Status ScrollPos
Coords = Result
PARSE VAR Coords scrollX scrollY
/* Draw matt */
BoxPrefs TEXTFLOW tflow LINEWT border FILL solid FILLCOLOR white
DrawBox 1 1 scrollY 6.5 5.5
firstobject = Result
/* Draw Grid */
scaleheight = 2.5 / maxY
LinePrefs TEXTFLOW none LINEWT hairline LINECOLOR black
IF increment = 0 THEN CALL skipgrid
DO i = 1 to TRUNC( maxY / increment)
ygrid = scrollY + 4.25 - increment * i * scaleheight
DrawLine 1 2.375 ygrid 7 ygrid
END
DrawLine 1 2.375 scrollY+4.25 7 scrollY+4.25
ygrid = scrollY + 4.25 - maxY * scaleheight
DrawLine 1 7 ygrid 7 scrollY + 4.25
/* Draw Y Axis Numbers */
TextBlockTypePrefs SIZE 14 COLOR Black
DrawTextBlock 1 2 scrollY+4.185 "0"
DO i = 1 to maxY / increment
ypos = ScrollY + 4.185 - (increment * i * scaleheight)
DrawTextBlock 1 2 ypos increment * i
END
skipgrid:
/* Draw Bars */
BoxPrefs TEXTFLOW none LINEWT 1 LINECOLOR Black FILL Solid
barwidth = 3.5 / bars
largeY= y.1
DO i=1 to (bars-1)
nextY = i+1
largeY = MAX( largeY , y.nextY )
END
DO i=1 to bars
color.1 = 'red'
q = i - 1
IF color.q= 'red' THEN color.i = 'yellow'
IF color.q = 'yellow' THEN color.i = 'magenta'
IF color.q = 'magenta' THEN color.i = 'green'
IF color.q = 'green' THEN color.i = 'cyan'
IF color.q = 'cyan' THEN color.i = 'brown'
IF color.q = 'brown' THEN color.i = 'red'
BoxPrefs FILLCOLOR color.i
lbox = 3 + (barwidth * i ) - barwidth
tbox = scrollY + 4.25 - (y.i * scaleheight)
hbox = y.i * scaleheight
DrawBox 1 lbox tbox barwidth hbox
DrawTextBlock 1 lbox (tbox-.2) y.i
/* position number */
GetObjectCoords
coords = Result
PARSE VAR coords page x1 y1 twidth theight
thalf = twidth / 2
xpos = x1 - thalf + barwidth/2
SetObjectCoords 0 1 xpos tbox-.2 twidth theight
lline = lbox + barwidth / 2
IF bars>2 THEN DO
IF i/2 = TRUNC(i/2) THEN DO
DrawLine 1 lline scrollY+4.25 lline scrollY+4.5625
END
END
DrawLine 1 lline scrollY+4.25 lline scrollY+4.375
END
BoxPrefs LINEWT none FILL solid FILLCOLOR white
/* Draw lables */
/* Title */
TextBlockTypePrefs SIZE 28 OBLIQUE 2
DrawTextBlock 1 2 scrollY title.1
GetObjectCoords
coords = Result
PARSE VAR coords page x1 y1 twidth theight
thalf = twidth / 2
xpos = 4.25 - thalf
SetObjectCoords 0 1 xpos scrollY+.25 twidth theight
/* SubTitle */
TextBlockTypePrefs SIZE 20 OBLIQUE 2
DrawTextBlock 1 2 scrollY title.2
GetObjectCoords
coords = Result
PARSE VAR coords page x1 y1 twidth theight
thalf = twidth / 2
xpos = 4.25 - thalf
SetObjectCoords 0 1 xpos scrollY+.75 twidth theight
/* X axis */
TextBlockTypePrefs SIZE 18 OBLIQUE 0
DrawTextBlock 1 2.5 scrollY+4.75 x.0
GetObjectCoords
coords = Result
PARSE VAR coords page x1 y1 twidth theight
thalf = twidth / 2
xpos = 4.75 - thalf
SetObjectCoords 0 1 xpos (scrollY+5) twidth theight
/* Yaxis */
DO i=1 to LENGTH(y.0)
yind.i = SUBSTR(y.0 , i , 1)
END
TextBlockTypePrefs SIZE 18
ypos = scrollY + 3 - LENGTH(y.0) / 2 * .2
DO i=1 to LENGTH(y.0)
DrawTextBlock 1 1.25 ypos yind.i
ypos = ypos + .2
END
/* Draw Bar labels */
TextBlockTypePrefs SIZE 12 COLOR Black
DO i=1 to bars
labelxpos = 3 + (i * barwidth) - (.5 *barwidth)
labelypos = scrollY + 4.4
DrawTextBlock 1 labelxpos labelypos x.i
lastobject = Result
GetObjectCoords
coords = Result
PARSE VAR coords page x1 y1 twidth theight
thalf = twidth / 2
xpos = labelxpos - thalf
IF bars>2 THEN DO
IF i/2 = TRUNC(i/2) THEN labelypos = labelypos + .2
END
SetObjectCoords 0 1 xpos labelypos twidth theight
END
/* Draw Axes */
LinePrefs TEXTFLOW none LINEWT 2 LINECOLOR Black
ypos = scrollY+4.25
DrawLine 1 2.5 ypos 7.125 ypos
DrawLine 1 2.5 ypos 2.5 scrollY+1.58
lastobject = Result
/* Group all */
DO i=firstobject to lastobject
SelectObject i MULTIPLE
END
Group
/***********************************************/
/* Clean up */
/* Remove extra page */
CtrlDown
AltDown
Cursor Down
Backspace
MoveToLine Begline 0
Redraw